home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro15 / novamax.pas < prev    next >
Pascal/Delphi Source File  |  1990-08-20  |  4KB  |  191 lines
  1. {
  2.  ******************************************************************************
  3.  * NOVAMAX - Line drawing and palette demo.                      *
  4.  *                                          *
  5.  * Written for GRAFIX by:  Joseph A. Albrecht                      *
  6.  *                                          *
  7.  * Press F10 to toggle between 320 and 640 graphic modes              *
  8.  * Press ESC to exit program                              *
  9.  ******************************************************************************
  10. }
  11.  
  12. PROGRAM Novamax;
  13.  
  14. USES
  15.   Crt,
  16.   Grafix;
  17.  
  18. VAR
  19.   Palettes: ARRAY[1..30] OF WORD;
  20.   A, B, C, D, J, M, MaxX, Graphics: INTEGER;
  21.   EndProgram, Loop, Tandy11: BOOLEAN;
  22.  
  23. PROCEDURE CheckKey;
  24.  
  25. VAR
  26.   Ch : CHAR;
  27.  
  28. BEGIN
  29.  
  30.    Ch := #255;
  31.    IF KeyPressed THEN
  32.      Ch := ReadKey;
  33.    IF Ch = #27 THEN
  34.      BEGIN
  35.        Loop := False;
  36.        EndProgram := True;
  37.      END;
  38.    IF Ch = #00 THEN
  39.      BEGIN
  40.        Ch := ReadKey;
  41.        IF (Ch = #68) AND (Tandy11 = True) THEN
  42.      BEGIN
  43.        IF Graphics = 320 THEN
  44.          BEGIN
  45.            Graphics := 640;
  46.            MaxX := 639;
  47.            M := 320;
  48.            Loop := False;
  49.            HighGraphics;
  50.          END
  51.        ELSE
  52.          BEGIN
  53.            Graphics := 320;
  54.            MaxX := 319;
  55.            M := 160;
  56.            Loop := False;
  57.            MediumGraphics;
  58.          END;
  59.      END;
  60.      END;
  61.  
  62. END;
  63.  
  64. {Mainline}
  65. BEGIN
  66.  
  67.   Graphics := 320;
  68.   EndProgram := False;
  69.   Loop := True;
  70.   MaxX := 319;
  71.   M := 160;
  72.   A := Blue;
  73.   B := Green;
  74.   C := Cyan;
  75.   D := Red;
  76.   GetTandy11(Tandy11);
  77.   MediumGraphics;
  78.  
  79.   J := 1;
  80.   WHILE J <= 30 DO
  81.     BEGIN
  82.       Palettes[J] := J Mod 15;
  83.       Inc(J, 1);
  84.     END;
  85.  
  86.   WHILE EndProgram = False DO
  87.     BEGIN
  88.       RANDOMIZE;
  89.       J := 0;
  90.       WHILE (J <= MaxX) AND (Loop = True) DO
  91.     BEGIN
  92.       CheckKey;
  93.       ExtLineC(J, 199, M, 100, A);
  94.       Inc(J, 2);
  95.       CheckKey;
  96.     END;
  97.       J := 0;
  98.       WHILE (J <= MaxX) AND (Loop = True) DO
  99.     BEGIN
  100.       ExtLineC(J, 0, M, 100, B);
  101.       Inc(J, 2);
  102.       CheckKey;
  103.     END;
  104.       J := 0;
  105.       WHILE (J <= 199) AND (Loop = True) DO
  106.     BEGIN
  107.       ExtLineC(M, 100, MaxX, J, C);
  108.       Inc(J, 2);
  109.       CheckKey;
  110.     END;
  111.       J := 0;
  112.       WHILE (J <= 199) AND (Loop = True) DO
  113.     BEGIN
  114.       ExtLineC(M, 100, 0, J, D);
  115.       Inc(J, 2);
  116.       CheckKey;
  117.     END;
  118.       IF Loop = True THEN
  119.     SetPalette(Random(2) + 1, Random(15) + 1);
  120.       J := 0;
  121.       WHILE (J <= MaxX) AND (Loop = True) DO
  122.     BEGIN
  123.       ExtLineC(J, 199, M, 100, D);
  124.       Inc(J, 4);
  125.       CheckKey;
  126.     END;
  127.       J := 0;
  128.       WHILE (J <= MaxX) AND (Loop = True) DO
  129.     BEGIN
  130.       ExtLineC(J, 0, M, 100, C);
  131.       Inc(J, 4);
  132.       CheckKey;
  133.     END;
  134.       J := 0;
  135.       WHILE (J <= 199) AND (Loop = True) DO
  136.     BEGIN
  137.       ExtLineC(M, 100, MaxX, J, B);
  138.       Inc(J, 4);
  139.       CheckKey;
  140.     END;
  141.       J := 0;
  142.       WHILE (J <= 199) AND (Loop = True) DO
  143.     BEGIN
  144.       ExtLineC(M, 100, 0, J, A);
  145.       Inc(J, 4);
  146.       CheckKey;
  147.     END;
  148.       J := 0;
  149.       WHILE (J <= MaxX) AND (Loop = True) DO
  150.     BEGIN
  151.       ExtLineC(J, 199, M, 100, C);
  152.       Inc(J, 8);
  153.       CheckKey;
  154.     END;
  155.       J := 0;
  156.       WHILE (J <= MaxX) AND (Loop = True) DO
  157.     BEGIN
  158.       ExtLineC(J, 0, M, 100, D);
  159.       Inc(J, 8);
  160.       CheckKey;
  161.     END;
  162.       J := 0;
  163.       WHILE (J <= 199) AND (Loop = True) DO
  164.     BEGIN
  165.       ExtLineC(M, 100, MaxX, J, A);
  166.       Inc(J, 8);
  167.       CheckKey;
  168.     END;
  169.       J := 0;
  170.       WHILE (J <= 199) AND (Loop = True) DO
  171.     BEGIN
  172.       ExtLineC(M, 100, 0, J, B);
  173.       Inc(J, 8);
  174.       CheckKey;
  175.     END;
  176.       J := 15;
  177.       WHILE (J > 1) AND (Loop = True) DO
  178.     BEGIN
  179.       PaletteUsing(Palettes[J]);
  180.       Dec(J, 1);
  181.       Pause(3);
  182.       CheckKey;
  183.     END;
  184.       CheckKey;
  185.       IF EndProgram = False THEN
  186.     Loop := True;
  187.    END;
  188.    ExitGraphics;
  189.  
  190. END.
  191.